COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00005 00003
C00009 00004	(defun pr-walk (class)
C00011 00005	Class Precedence List
C00021 00006	/sub
C00034 00007	/sub
C00042 ENDMK
C⊗;

(init)

(defclass c1 (c2 c6 c5) ())
(defclass c2 (c3 c4) ())
(defclass c3 (c5) ())
(defclass c4 (c6) ())
(defclass c5 () ())
(defclass c6 () ())

(print-nodes)
(compute-total-order 'c1)

(init)

(defclass c1 (c3 c2) ())
(defclass c2 (c3) ())
(defclass c3 () ())

(compute-total-order 'c1)

(cpl-less 'c5 'c6)
(cpl-less 'c6 'c5)

*lattice*
*local-info*
(compute-alpha-paths 'c1 *lattice*)

(defun init-local-info (node)
 (setf (root *local-info*) node)
 (setf (total-order *local-info*) ())
 (setf (lattice *local-info*) *lattice*)
 (compute-alphabetical-paths *local-info*)
 node)

(init-local-info 'c1)

*local-info*

(cpl-less 'c3 'c5)

(in-lattice-order 'c6 'c5)

(in-local-precedence-order 'c6 'c5)


(untrace)
(trace in-kleene-brouwer-order)

(all-nodes *lattice*)

(alphabetical-paths *local-info*)
(*catch 'foo (*throw 'foo 'baz))

(defun cpl-less (node1 node2)
 (cond ((eq node1 node2) nil)
       (t (let ((p (cpl-less-1 node1 node2)))
	       (cond ((or (and (in-lattice-order node1 node2)
			       (in-local-precedence-order node2 node1))
	                  (and (in-lattice-order node2 node1)
			       (in-local-precedence-order node1 node2))
			  (eq p (cpl-less-1 node2 node1)))
		      (error '|Inconsistent Lattice|)
		      (*throw 'inconsistent-lattice nil))
		     (t p))))))

(DEFCLASS C1 () ())
(DEFCLASS C2 () ())
(DEFCLASS C3 () ())
(DEFCLASS C4 (C1 C2) ())
(DEFCLASS C5 (C3 C2) ())
(DEFCLASS C6 (C4 C5) ())

(compute-total-order 'c6)

(defun print-nodes ()
 (do ((nodes *node-alist* (cdr nodes)))
     ((null nodes))
  (let ((nr (node-record (car nodes))))
   (print `(,(name nr) (count = ,(count nr)) (pseudo-order = ,(pseudo-order nr))
            (superclasses
	     ,(do ((l (direct-superclasses nr) (cdr l))
		   (ans ()))
		  ((null l) (reverse ans))
		  (push (name (car l)) ans)))
            (successors
	     ,(do ((l (top nr) (cdr l))
		   (ans ()))
		  ((null l) (reverse ans))
		  (push (name (car l)) ans))))))))

(init)
(defclass c1 (c2 c6 c5) ())
(defclass c2 (c3 c4) ())
(defclass c3 (c5) ())
(defclass c4 (c6) ())
(defclass c5 (top) ())
(defclass c6 (top) ())

(let ((*preorder-counter* 0))
 (preorder-walk (find-node-record 'c1)))

(print-nodes)

(topologically-sort 'c1)
	= (C1 C2 C3 C4 C6 C5 TOP) 

(init)
(defclass c2 (c3 c4) ())
(defclass c3 (c5) ())
(defclass c4 (c6) ())
(defclass c5 (top) ())
(defclass c6 (top) ())

(topologically-sort 'c2)
	= (C2 C3 C5 C4 C6 TOP) 

(init)
(defclass c1 (c3 c2) ())
(defclass c2 (c3) ())
(defclass c3 (top) ())

(topologically-sort) 
	= Inconsistent Lattice

(init)
(defclass c1 (top) ())
(defclass c2 (top) ())
(defclass c3 (top) ())
(defclass c4 (c1 c2) ())
(defclass c5 (c3 c2) ())
(defclass c6 (c4 c5) ())

(topologically-sort)
	= (C6 C4 C5 C1 C3 C2 TOP) 

(init)
(defclass c1 (top) ())
(defclass c2 (top) ())
(defclass c3 (top) ())
(defclass d4 (c3 c2) ())
(defclass d5 (c2) ())
(defclass d6 (c3 c2 d5 d4) ())

(topologically-sort)
 = Inconsistent Lattice

(init)
(defclass c1 () ())
(defclass c2 () ())
(defclass c3 () ())
(defclass e1 (c1) ())
(defclass e2 (c2) ())
(defclass e3 (c3) ())
(defclass e4 (e3 e2 e1) ())
(defclass e5 (c1 c2) ())
(defclass e6 (c2 c3) ())
(defclass e7 (e5 e6 e4) ())

(topologically-sort 'e7)
 = (E7 E5 E6 E4 E3 E2 E1 C1 C2 C3)

(init)
(defclass apple (fruit) ())
(defclass cinnamon (spice) ())
(defclass fruit (food) ())
(defclass spice (food) ())
(defclass food () ())
(defclass pie (apple cinnamon) ())
;(defclass pastry (cinnamon apple) ())

(topologically-sort 'pastry)

(init)
(defclass pie (apple cinnamon) ())
(defclass apple (fruit) ())
(defclass cinnamon (spice) ())
(defclass fruit () ())
(defclass spice () ())

 (topologically-sort 'pie)

(defun pr-walk (class)
 (push (name class) *pre*)
 (dolist (superclass (direct-superclasses class))
	 (pr-walk superclass)))

(defun pw-rear (class-name)
 (let ((*pre* nil))
  (pr-walk (find-node-record class-name))
  (let ((ans ()))
   (do ((pre *pre* (cdr pre)))
       ((null pre) ans)
       (unless (memq (car pre) ans) (push (car pre) ans))))))

(defun pw-front (class-name)
 (let ((*pre* nil))
  (pr-walk (find-node-record class-name))
  (let ((ans ()))
   (do ((pre (reverse *pre*) (cdr pre)))
       ((null pre) (reverse ans))
       (unless (memq (car pre) ans) (push (car pre) ans))))))

(pw-front 'e7)

(init)
(defclass c1 () ())
(defclass c2 () ())
(defclass c3 () ())
(defclass e1 (c1) ())
(defclass e2 (c2) ())
(defclass e3 (c3) ())
(defclass e4 (e3 e2 e1) ())
(defclass e5 (c1 c2) ())
(defclass e6 (c2 c3) ())
(defclass e7 (e5 e6 e4) ())
Class Precedence List

I've been searching for a way to explain the class precedence
list computation that is simpler than the existing explanations.
I think it can be explained like this:

We will compute the total order on classes at or above the class, C.  Call
the top of the class lattice TOP.  Let CL be the set of classes at or
above C. Sort this set according to the relation, <, defined as follows:

Consider C1 and C2 in CL.

	1. If there exists a path, P, from C to TOP such that
           C1 and C2 are in P, then C1<C2 iff C1 is closer to C
           along P. [This is the lattice order.]

	2. If C1 and C2 are direct superclasses of C3, where C3 is
           in CL, then  C1<C2 iff C1 precedes C2 in the local precedence
           list for C3. [This is the local precedence order.]

	3. Let P1 be the alphabetically least path from C to TOP containing C1.
	   Let P2 be the alphabetically least path from C to TOP containing C2.
	   Let C3 and C4 be the first classes in P1 and P2, resp, that differ.
	   Then C1<C2 if C3<C4. 
	   [This is the Kleene-Brouwer order.]

We will say that there is no total order on a set of classes, CL, above a
class C if there exists two classes C1 and C2 in CL such that C1<C2 and
C2<C1 under this order or if clauses 1. and 2. yield inconsistent results.
That is, there is no total order if the lattice order and local
precedence orders contradict each other immediately or if the overall
relationship is inconsistent. (These two cases are separate because
we want to say that the relation is indifferent as to whether the lattice
order or local precedence order is tested first, but an algorithm
tests one before the other. Note the ``if and only if''s in clauses
1 and 2.)

Before I explain some of the terminology more thoroughly, let me point out
that the order defined by 1 and 3 is called the Kleene-Brouwer ordering on
finite trees. This is good, because it is a well-known ordering, and the
class precedence list is computed using a natural extension to it.

A path from C1 to C2 is defined to be an ordered set of classes CL1...CLn,
such that C1=CL1, C2=CLn, and for every i=1...n-1, CL(i+1) is a direct
superclass of CLi.

We say that a class C is in a path P={C1...Cn} if C=Ci for some i between
1 and n, inclusive.

Let P={C1...Cn} be a path from C1 to Cn. Then we say that C3 is closer to
C1 than C4 in P if there exists a Ci and Cj such that Ci is in P, Cj is in
P,C3=Ci, C4=Cj, and i<j. We extend this terminology in the natural way: we
say that C is the first class in the path P that satisfies some predicate,
PR, to mean that there exists a Ci in P such that PR(Ci) is true and that
if 0<j<i, PR(Cj) is not true.

Let P1={D1...Dn} and P2={E1...Em} be paths from C1 to C2.  Note that
D1=E1=C1 and Dn=Em=C2.  We say that P1 is alphabetically less than P2 if
P1 and P2 are different and if the following is true:

	   Let Di and Ei be the first classes in P1 and P2, resp, that
	   differ. Note that 1<i<n, 1<i<m, and D(i-1)=E(i-1). The
	   condition is that Di precedes Ei in the local precedence order
	   for D(i-1).

(This might sound complex, but you can generate the paths in alphabetical
order by doing a depth-first traversal of the tree from C1 to C2, collecting
the paths as you go.)

I think this is simpler because the lattice order and local precedence
have an obvious role in the total order. Also, the Kleene-Brouwer order
depends on looking at the least paths through the classes in question,
which depends on the lattice and local precedence orders, and seeing how
the first different classes in those two paths differ. The effect of the
Kleene-Brouwer condition is to impose an alphabetical order on the
lattice in a natural way.

I think people can understand the relation so defined, and it is easier to
invoke an explicit sorting operation rather than blending the sort with
the computation of the relation, as earlier attempts at it explaining the
computation of the total do.

Of course, I hacked this up (though not very elegantly) and it works well
on the one or two examples I ran it on.

If you want to know what it does on some lattice, send me a note
with a class lattice that is in this syntax and I'll run it:

(defclass c1 (c2 c6 c5) ())
(defclass c2 (c3 c4) ())
(defclass c3 (c5) ())
(defclass c4 (c6) ())
(defclass c5 () ())
(defclass c6 () ())

(compute-total-order 'c1) = (C1 C2 C3 C4 C6 C5) 
(compute-total-order 'c2) = (C2 C3 C5 C4 C6) 

(defclass c1 (c3 c2) ())
(defclass c2 (c3) ())
(defclass c3 () ())

(compute-total-order 'c1) = Inconsistent Lattice

(defclass c1 () ())
(defclass c2 () ())
(defclass c3 () ())
(defclass c4 (c1 c2) ())
(defclass c5 (c3 c2) ())
(defclass c6 (c4 c5) ())

(compute-total-order 'c6) = (C6 C4 C1 C5 C3 C2) 

(defclass c1 () ())
(defclass c2 () ())
(defclass c3 () ())
(defclass d4 (c3 c2) ())
(defclass d5 (c2) ())
(defclass d6 (c3 c2 d5 d4) ())

(compute-total-order 'd6)  = Inconsistent Lattice

(defclass c1 () ())
(defclass c2 () ())
(defclass c3 () ())
(defclass e1 (c1) ())
(defclass e2 (c2) ())
(defclass e3 (c3) ())
(defclass e4 (e3 e2 e1) ())
(defclass e5 (c1 c2) ())
(defclass e6 (c2 c3) ())
(defclass e7 (e5 e6 e4) ())

(compute-total-order 'e7) = (E7 E5 C1 E6 E4 C2 E3 C3 E2 E1) 
The correct answer is (E7 E5 E6 E4 E3 E2 E1 C1 C2 C3).

(compute-total-order 'e7)
(cpl-less 'c3 'c1)
(compare 'c1 'c3)
(E7 E5 E6 E4 E3 E2 E1 C3 C1 C2) 
(cpl-less 'c1 'c2)
(cpl-less 'c2 'c3)
(trace in-kleene-brouwer-order)
(untrace)
(compare 'c3 'e2)
(compare 'e2 'c3)
(trace compare)
(compare 'c1 'c3)
(E7 E5 E6 E4 E3 C3 E2 E1 C1 C2) 

(init)
(defclass pie (apple cinnamon) ())
(defclass apple (fruit) ())
(defclass cinnamon (spice) ())
(defclass fruit () ())
(defclass spice () ())

(compute-total-order 'pie)
/sub
common-lisp-object-system
Class Precedence List

This message is long because there are a lot of examples of code running
at the end.

I've been searching for a way to explain the class precedence list
computation that is simpler than the existing explanations.  I think we
can explain it fairly well if we relax, a bit, the requirements of
implementations, though we can certainly recommend that implementations go
the extra distance. What I'm proposing is a subset of the behavior that
the Moon algorithm has, but it is simple to explain and understand.

Here it is. We represent a partial order as a set of pairs, (x,y), such
that (x,y) indicates that x<y.  Here are the assumed rules of the relation
<.

If x<y and y<z then x<z (transitivity)
If x<y then it is not the case that y<x  (asymmetry)
It is not the case that x<x (irreflexivity)

If x<y we'll say that ``x precedes y.'' We then define a partial order on
the components of a class, C1, as follows. Let CL be the components of C1.
If D is a direct superclass of C, where C is in CL, then (C,D) is in the
partial order. If D1 and D2 are direct superclasses of C, where C is in
CL, such that D1 precedes D2 in the local precedence order, then
(D1,D2) is in the partial order. (Note, these correspond to Moon's rules 1
and 2, but we explicitly list the pairs of relations, and we deal with
direct superclasses only.)

Now we topologically sort the elements of CL. This is done as follows.
Select a class C that is not preceded by any other. Put it first in the order.
Remove C from CL and remove all pairs that mention it. This new CL is again
partially ordered by the new pairs. Select a C that is not preceded by
any other and put it next in the order. Continue until CL is empty.

The only way that the algorithm could fail, if there really was a partial
order to start with, would be if there were elements in CL at some point
and every C in CL was preceded by another. If this were true, we could
construct an arbitrary sequence, C1, C2, ... such that Cj+1<Cj.  By
transitivity, for all j,k s.t. j<k, Ck<Cj, which implies that Cj is not
equal to Ck.  But CL is finite, so some Cj=Ck for some j,k s.t. j<k. This
is a contradiction.

So, if the algorithm fails, we did not have a partial order, which means that
the local precedence order and the lattice order are inconsistent. The algorithm
does signal an error when this happens.

Topological sort runs in C1*M+C2*N time where M is the number of ordered pairs
and N is the number of objects in CL, C1 and C2 some constants.

I hacked this together, and it is 27 lines of code once the data structure
is built. Building the data structure incrementally from a series of
DEFCLASS1's as Moon uses in his examples is another 25 lines of so of code.
The total file is 84 lines long, including the DEFSTRUCT and the code to
make MacLisp think it's Common Lisp enough to run the rest (blush, I
have no Common Lisp to use on SAIL).

The code is an approximate translation of Knuth's algorithm on page 262 of
vol 1 (first edition). It takes the precise DEFCLASS's that define the 
sublattice, but it's intended to only illustrate the algorithm at work.

If there are several total orders, the result of the topological sort depends
on the order that the algorithm selects classes that are not preceded by
any others. This depends, generally, on the order that the DEFCLASS's were
evaluated.

I propose that we require implementations to select a total order using an
implementation of topological sort, and that we encourage implementations
to signal an error when several total orders are possible. They can do
this using Moon's algorithm, for example, or by using the topological sort
and having the program notice when there are several classes not preceded
by others from which to select. It could backtrack and determine all of
them, I suppose.

I think this is simpler because many people know topological sort already,
they can understand the partial order in terms of these simple pairs, and
the topological sort algorithm can be explained in a paragraph. People can
also easily see where the non-determinism comes in if there are several
total orders. (Note that most people would know the algorithm after 
reading the specification of the partial order as those pairs and seeing
the phrase ``now topologically sort.'')

Here it is running on some examples Moon, Danny, Gregor, and who knows who
else sent out (notice I changed the name of DEFCLASS1 to DEFCLASS). TOP
means the top of the lattice.

(defclass c1 (c2 c6 c5) ())
(defclass c2 (c3 c4) ())
(defclass c3 (c5) ())
(defclass c4 (c6) ())
(defclass c5 (top) ())
(defclass c6 (top) ())
(topologically-sort) = (C1 C2 C3 C4 C6 C5 TOP) 

;;; Here are the partial order defining pairs for the above example:
;;; (c1,c2)(c1,c6)(c1,c5)(c2,c6)(c6,c5)(c2,c3)(c2,c4)(c3,c4)
;;; (c3,c5)(c4,c6)(c5,top)(c6,top)

(defclass c2 (c3 c4) ())
(defclass c3 (c5) ())
(defclass c4 (c6) ())
(defclass c5 (top) ())
(defclass c6 (top) ())
(topologically-sort) = (C2 C3 C5 C4 C6 TOP) 

(defclass c1 (c3 c2) ())
(defclass c2 (c3) ())
(defclass c3 (top) ())
(topologically-sort) = Inconsistent Lattice

(defclass c1 (top) ())
(defclass c2 (top) ())
(defclass c3 (top) ())
(defclass c4 (c1 c2) ())
(defclass c5 (c3 c2) ())
(defclass c6 (c4 c5) ())
(topologically-sort) = (C6 C4 C5 C1 C3 C2 TOP) 

(defclass c1 (top) ())
(defclass c2 (top) ())
(defclass c3 (top) ())
(defclass d4 (c3 c2) ())
(defclass d5 (c2) ())
(defclass d6 (c3 c2 d5 d4) ())
(topologically-sort) = Inconsistent Lattice

(defclass c1 (top) ())
(defclass c2 (top) ())
(defclass c3 (top) ())
(defclass e1 (c1) ())
(defclass e2 (c2) ())
(defclass e3 (c3) ())
(defclass e4 (e3 e2 e1) ())
(defclass e5 (c1 c2) ())
(defclass e6 (c2 c3) ())
(defclass e7 (e5 e6 e4) ())
(topologically-sort) = (E7 E5 E6 E4 E3 E2 E1 C1 C2 C3)

(defclass c1 (top) ())
(defclass c2 (top) ())
(defclass d1 (c1) ())
(defclass d2 (c2) ())
(defclass e1 (d1 d2) ())
(topologically-sort) = (E1 D1 D2 C1 C2 TOP)

(defclass c1 (top) ())
(defclass c2 (top) ())
(defclass c3 (top) ())
(defclass d1 (c1 c2) ())
(defclass d2 (c1 c3) ())
(defclass e1 (d1 d2) ())
(topologically-sort) = (E1 D1 D2 C1 C3 C2 TOP) 

(defclass c2 (top) ())
(defclass c3 (top) ())
(defclass d4 (c3 c2) ())
(defclass d5 (c2) ())
(defclass d6 (c3 c2 d5 d4) ())
(topologically-sort) = Inconsistent Lattice

(defclass o (top) ())
(defclass b1 (o) ())
(defclass b2 (o) ())
(defclass b3 (o) ())
(defclass b4 (o) ())
(defclass ex1-1 (b1 b3 b4) ())
(defclass ex1-2 (b2 b3) ())
(defclass example-1 (ex1-1 ex1-2) ())
(topologically-sort) = (EXAMPLE-1 EX1-1 EX1-2 B1 B2 B3 B4 O TOP) 

(defclass o (top) ())
(defclass b1 (o) ())
(defclass b2 (o) ())
(defclass b3 (o) ())
(defclass ex2-1 (b1) ())
(defclass ex2-2 (b2) ())
(defclass ex2-3 (b3) ())
(defclass example-2 (ex2-1 ex2-2 ex2-3) ())
(topologically-sort) = (EXAMPLE-2 EX2-1 EX2-2 B1 EX2-3 B2 B3 O TOP) 

(defclass d0 (top) ())
(defclass d1 (top) ())
(defclass d2 (top) ())
(defclass d3 (top) ())
(defclass e (d0 d1) ())
(defclass f (d1 d2 d3) ())
(defclass g (d1 d2) ())
(defclass h (d0) ())
(defclass foo (e f g h) ())
(topologically-sort) = (FOO E F G H D0 D1 D2 D3 TOP) 

(defclass d1 (top) ())
(defclass d2 (top) ())
(defclass d3 (top) ())
(defclass d4 (d3 d2) ())
(defclass d5 (d2) ())
(defclass d6 (d3 d2 d5 d4) ())
(topologically-sort) = Inconsistent Lattice

(defclass g1 (top) ())
(defclass g2 (top) ())
(defclass g3 (top) ())
(defclass g4 (top) ())
(defclass g5 (g1 g2) ())
(defclass g6 (g2 g3) ())
(defclass g7 (g3 g4) ())
(defclass g8 (g4 g5 g6 g7) ())
(topologically-sort) = Inconsistent Lattice

(defclass this (is much) ())
(defclass is (too) ())
(defclass much (fun!) ())
(defclass too () ())
(defclass fun! () ())
(topologically-sort) = (THIS IS TOO MUCH FUN!) 

			-rpg-

/sub
common-lisp-object-system
Very Dull Message About Class Precedence Lists

For those who are actively thinking about this issue, here is a followup
on my last message about topological sort. It mostly contains a bunch of
runs of a slightly modified algorithm. The modifications are that it now
reports when multiple orders are possible, and, when there is a choice
between several classes with no predecessors, the algorithm selects the
one that appear first in a preorder treewalk from the class for which the
class precedence list is being computed to the top of the lattice (viewed
as a tree). I believe that this algorithm produces the same results as
the New Flavors algorithm, but it is easier to explain: 1. Compute the
partial order relations; 2. topologically sort; 3. when topological sort
has a choice of several classes to put next, select according to preorder.

(init)
(defclass c1 (c2 c6 c5) ())
(defclass c2 (c3 c4) ())
(defclass c3 (c5) ())
(defclass c4 (c6) ())
(defclass c5 (top) ())
(defclass c6 (top) ())

(topologically-sort 'c1)
 = (C1 C2 C3 C4 C6 C5 TOP) 

(init)
(defclass c2 (c3 c4) ())
(defclass c3 (c5) ())
(defclass c4 (c6) ())
(defclass c5 (top) ())
(defclass c6 (top) ())

(topologically-sort 'c2)
  = (C2 C3 C5 C4 C6 TOP)  Multiple orders possible

(init)
(defclass c1 (c3 c2) ())
(defclass c2 (c3) ())
(defclass c3 (top) ())

(topologically-sort 'c1)
 = Inconsistent Lattice

(init)
(defclass c1 (top) ())
(defclass c2 (top) ())
(defclass c3 (top) ())
(defclass c4 (c1 c2) ())
(defclass c5 (c3 c2) ())
(defclass c6 (c4 c5) ())

(topologically-sort 'c6)
 = (C6 C4 C1 C5 C3 C2 TOP)  Multiple orders possible

(init)
(defclass c1 (top) ())
(defclass c2 (top) ())
(defclass c3 (top) ())
(defclass d4 (c3 c2) ())
(defclass d5 (c2) ())
(defclass d6 (c3 c2 d5 d4) ())

(topologically-sort 'd6)
 = Inconsistent Lattice

(init)
(defclass c1 (top) ())
(defclass c2 (top) ())
(defclass c3 (top) ())
(defclass e1 (c1) ())
(defclass e2 (c2) ())
(defclass e3 (c3) ())
(defclass e4 (e3 e2 e1) ())
(defclass e5 (c1 c2) ())
(defclass e6 (c2 c3) ())
(defclass e7 (e5 e6 e4) ())

(topologically-sort 'e7)
 = (E7 E5 E6 E4 E3 E2 E1 C1 C2 C3 TOP)

(init)
(defclass c1 (top) ())
(defclass c2 (top) ())
(defclass d1 (c1) ())
(defclass d2 (c2) ())
(defclass e1 (d1 d2) ())

(topologically-sort 'e1)
 = (E1 D1 C1 D2 C2 TOP) Multiple orders possible

(init)
(defclass c1 (top) ())
(defclass c2 (top) ())
(defclass c3 (top) ())
(defclass d1 (c1 c2) ())
(defclass d2 (c1 c3) ())
(defclass e1 (d1 d2) ())

(topologically-sort 'e1)
 = (E1 D1 D2 C1 C2 C3 TOP) Multiple orders possible

(init)
(defclass c2 (top) ())
(defclass c3 (top) ())
(defclass d4 (c3 c2) ())
(defclass d5 (c2) ())
(defclass d6 (c3 c2 d5 d4) ())

(topologically-sort 'd6)
 = Inconsistent Lattice

(init)
(defclass b1 (top) ())
(defclass b2 (top) ())
(defclass b3 (top) ())
(defclass b4 (top) ())
(defclass ex1-1 (b1 b3 b4) ())
(defclass ex1-2 (b2 b3) ())
(defclass example-1 (ex1-1 ex1-2) ())

(topologically-sort 'example-1)
 = (EXAMPLE-1 EX1-1 B1 EX1-2 B2 B3 B4 TOP) Multiple orders possible

(init)
(defclass b1 (top) ())
(defclass b2 (top) ())
(defclass b3 (top) ())
(defclass ex2-1 (b1) ())
(defclass ex2-2 (b2) ())
(defclass ex2-3 (b3) ())
(defclass example-2 (ex2-1 ex2-2 ex2-3) ())

(topologically-sort 'example-2)
 = (EXAMPLE-2 EX2-1 B1 EX2-2 B2 EX2-3 B3 TOP) Multiple orders possible

(init)
(defclass d0 (top) ())
(defclass d1 (top) ())
(defclass d2 (top) ())
(defclass d3 (top) ())
(defclass e (d0 d1) ())
(defclass f (d1 d2 d3) ())
(defclass g (d1 d2) ())
(defclass h (d0) ())
(defclass foo (e f g h) ())

(topologically-sort 'foo)
 = (FOO E F G H D0 D1 D2 D3 TOP) 

(init)
(defclass d1 (top) ())
(defclass d2 (top) ())
(defclass d3 (top) ())
(defclass d4 (d3 d2) ())
(defclass d5 (d2) ())
(defclass d6 (d3 d2 d5 d4) ())

(topologically-sort 'd6)
 = Inconsistent Lattice

(init)
(defclass g1 (top) ())
(defclass g2 (top) ())
(defclass g3 (top) ())
(defclass g4 (top) ())
(defclass g5 (g1 g2) ())
(defclass g6 (g2 g3) ())
(defclass g7 (g3 g4) ())
(defclass g8 (g4 g5 g6 g7) ())

(topologically-sort 'g8)
 = Inconsistent Lattice

(init)
(defclass this (is much) ())
(defclass is (too) ())
(defclass much (fun!) ())
(defclass too (top) ())
(defclass fun! (top) ())

(topologically-sort 'this)
 = (THIS IS TOO MUCH FUN!) Multiple orders possible

			-rpg-